home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 45
/
Aminet 45 (2001)(GTI - Schatztruhe)[!][Oct 2001].iso
/
Aminet
/
dev
/
e
/
yaec.lha
/
examples
/
ecode.e
< prev
next >
Wrap
Text File
|
2001-08-12
|
7KB
|
315 lines
LINKOBJECT
MODULE 'exec/memory',
'hardware/custom',
'utility/hooks'
-> ecode.e - from Jasons R Hulance`s UsefulV2.
-> YAEC Notes :
-> - Compiled as external linklib.
-> - Function-names changed to start with upper-case.
-> - Alot changes in asm-parts, but still recogniseable.
-> YAEC1.6a :
-> - Added ECodeUtilHook(). Anything else ?
-> - Fixed some various bugs.
RAISE "MEM" IF New()=NIL
->EXPORT PROC Test(x,y,z) IS WriteF('testing \d,\d,\d\n',x,y,z)
-> Wraps an E function so it can still access globals, even from other tasks.
EXPORT PROC ECode(func) IS setup(func,({start}),({end})-({start}))
-> Wraps an E function as above, but also preserves the non-scratch registers.
EXPORT PROC ECodePreserve(func) IS setup(func,({pStart}),({pEnd})-({pStart}))
-> Wraps an E function for use with createTask()
EXPORT PROC ECodeTask(func) IS ECode(func)
-> Wraps an E function for use as an ASL hook
EXPORT PROC ECodeASLHook(func) IS setup(func,({aStart}),({aEnd})-({aStart}))
-> Wraps an E function for use as an CX custom function
EXPORT PROC ECodeCxCustom(func) IS setup(func,({cStart}),({cEnd})-({cStart}))
-> Wraps an E function for use as a GEL collision function
EXPORT PROC ECodeCollision(func) IS ECodeCxCustom(func)
-> Wraps an E function for use as an interrupt handler
EXPORT PROC ECodeIntHandler(func) IS setup(func,({hStart}),({hEnd})-({hStart}))
-> Wraps an E function for use as an interrupt server
EXPORT PROC ECodeIntServer(func) IS setup(func,({sStart}),({sEnd})-({sStart}))
-> Wraps an E function for use as a software interrupt
EXPORT PROC ECodeSoftInt(func) IS setup(func,({iStart}),({iEnd})-({iStart}))
-> Wraps an E function as eCode(), but swaps the order of two args
EXPORT PROC ECodeSwapArgs(func) IS setup(func,({oStart}),({oEnd})-({oStart}))
EXPORT PROC ECodeDispose(mem:PTR TO LONG)
IF mem
IF mem::hook.entry = {entry} THEN RETURN FastDispose(mem, SIZEOF ecodehook)
mem := mem - 12
IF mem[2] THEN Dispose(mem[2])
Dispose(mem)
ENDIF
ENDPROC
PROC setup(func, addr, len) HANDLE
DEF mem:PTR TO LONG, a4
mem := New(len) ->mem:=NewM(len, MEMF_PUBLIC)
-> Fully relocatable code can be copied to another memory location
CopyMem(addr, mem, len)
mem[]++:=func
->a4 := A4 ->MOVE.L A4, a4
mem[]++:= A4 -> I just know this is okey.
mem[]++:= New(400)
IF KickVersion(36) THEN CacheClearU() -> Write out the cache (68040 especially bad...)
RETURN mem
EXCEPT
RETURN NIL
ENDPROC
OBJECT ecodehook OF hook
priv[100]:ARRAY OF LONG
ENDOBJECT
-> Wraps an E function for use as an Utility hook
EXPORT PROC ECodeUtilHook(func, data)
DEF h:PTR TO ecodehook
NEW h
h.subentry := func
h.entry := {entry}
h.data := data
ENDPROC h
->EXPORT PROC InstallHook(hook, func)
->ENDPROC
entry:
ASM ' movem.l d2-d7/a2-a6,-(a7)' -> save regs
ASM ' move.l a0,-(a7)' -> hook
ASM ' move.l a2,-(a7)' -> obj
ASM ' move.l a1,-(a7)' -> msg
ASM ' move.l a4storage, a4' -> reinstate a4
ASM ' lea.l 20(a0), a2' -> a2space
ASM ' moveq.l #-1, d7' -> clear exception
ASM ' move.l 12(a0),a0' -> get sub-entry
ASM ' jsr (a0)' -> execute function
ASM ' movem.l (a7)+,d2-d7/a2-a6' -> restore regs
ASM ' rts' -> return
start:
ASM
.function:
dc.l 0
.storea4:
dc.l 0
.a2space:
dc.l 0
.entry:
move.l .storea4(pc), a4 ;-> restore a4
move.l .a2space(pc), a2
move.l .function(pc), a6
moveq.l #-1, d7
jsr (a6) ;-> Call real function
rts
ENDASM
end:
pStart:
ASM
.pfunction:
dc.l 0
.pstorea4:
dc.l 0
.a2space:
dc.l 0
.pentry:
movem.l d2-d7/a2-a6, -(a7) ;-> preserve registers
move.l .pstorea4(pc), a4 ; -> restore a4
move.l .a2space(pc), a2
move.l .pfunction(pc), a5
moveq.l #-1, d7
jsr (a5) ;-> call real function
movem.l (a7)+, d2-d7/a2-a6 ;-> restore registers
rts
ENDASM
pEnd:
-> aslhook
aStart:
ASM
.afunction:
dc.l 0
.astorea4:
dc.l 0
.a2space:
dc.l 0
.aentry:
lea .astack(pc), a0
movem.l d2-d7/a1-a6, (a0) ;-> preserve registers
move.l .astorea4(pc), a4 ; -> restore a4
move.l .afunction(pc), a6
move.l .a2space(pc), a2
move.l 4(a7), a0 ; swap 3 args
move.l 8(a7), a1
move.l 12(a7), d0
move.l a0, -(a7)
move.l a1, -(a7)
move.l d0, -(a7)
moveq.l #-1, d7
jsr (a6) ;-> call real function
lea .astack(pc), a0
movem.l (a0), d2-d7/a1-a6 ;-> restore registers
rts
.astack:
dc.l 2,3,4,5,6,7,1,2,3,4,5,6,0
ENDASM
aEnd:
->cx/collision
cStart:
ASM
.cfunction:
dc.l 0
.cstorea4:
dc.l 0
.a2space:
dc.l 0
.centry:
lea .cstack(pc), a0
movem.l d2-d7/a1-a6, (a0) ;-> preserve registers
move.l .cstorea4(pc), a4 ; -> restore a4
move.l .cfunction(pc), a6
move.l .a2space(pc), a2
move.l 4(a7), a0 ; swap 2 args
move.l 8(a7), a1
move.l a0, -(a7)
move.l a1, -(a7)
moveq.l #-1, d7
jsr (a6) ;-> call real function
lea .cstack(pc), a0
movem.l (a0), d2-d7/a1-a6 ;-> restore registers
rts
.cstack:
dc.l 2,3,4,5,6,7,1,2,3,4,5,6,0
ENDASM
cEnd:
hStart:
ASM
.hfunction:
dc.l 0
.hstorea4:
dc.l 0
.a2space:
dc.l 0
.hentry:
lea .hstack(pc), a0
movem.l d2-d7/a2-a4, (a0) ;-> preserve registers
move.l .hstorea4(pc), a4 ; -> restore a4
move.l .hfunction(pc), a0
movem.l d1/a1, -(a7) ;-> push d1 and a1 as arguments
move.l .a2space(pc), a2
moveq.l #-1, d7
jsr (a0) ;-> call real function
lea .hstack(pc), a0
movem.l (a0), d2-d7/a2-a4 ;-> restore registers
rts
.hstack:
dc.l 2,3,4,5,6,7,2,3,4,0
ENDASM
hEnd:
sStart:
ASM
.sfunction:
dc.l 0
.sstorea4:
dc.l 0
.a2space:
dc.l 0
.sentry:
lea .sstack(pc), a0
movem.l d2-d7/a2-a4, (a0) ; -> preserve registers
move.l .sstorea4(pc), a4 ; -> restore a4
move.l .sfunction(pc), a6
move.l a1, -(a7) ; -> push a1 as an argument
move.l .a2space(pc), a2
moveq.l #-1, d7
jsr (a6) ; -> call real function
lea .sstack(pc), a0
movem.l (a0), d2-d7/a2-a4 ; -> restore registers
move.l #$DFF000, a0 ;-> CUSTOMADDR
tst.l d0 ; -> set z flag according to func result
rts
.sstack:
dc.l 2,3,4,5,6,7,2,3,4,0
ENDASM
sEnd:
iStart:
ASM
.ifunction:
dc.l 0
.istorea4:
dc.l 0
.a2space:
dc.l 0
.ientry:
lea .istack(pc), a0
movem.l d2-d7/a2-a4/a6, (a0) ; -> preserve registers
move.l .istorea4(pc), a4 ; -> restore a4
move.l .ifunction(pc), a6
move.l a1, -(a7) ; -> push a1 as an argument
move.l .a2space(pc), a2
moveq.l #-1, d7
jsr (a6) ; -> call real function
lea .istack(pc), a0
movem.l (a0), d2-d7/a2-a4/a6 ; -> restore registers
rts
.istack:
dc.l 2,3,4,5,6,7,2,3,4,6,0
ENDASM
iEnd:
oStart:
ASM
.ofunction:
dc.l 0
.ostorea4:
dc.l 0
.a2space:
dc.l 0
.oentry:
move.l 4(a7), a0 ;-> swap 2 arguments
move.l 8(a7), a1
move.l a2, -(a7) ; save a2
move.l a0, -(a7)
move.l a1, -(a7)
move.l .ostorea4(pc), a4 ; -> restore a4
move.l .ofunction(pc), a0
move.l .a2space(pc), a2
moveq.l #-1, d7
jsr (a0) ;-> Call real function
move.l (a7)+, a2 ; restore a2
rts
ENDASM
oEnd: